# want the wide data for degree-related
egodat <- readRDS("~/nsfg_data_cleaning/Objects/fullEgodata.rds")
egosvy <- as_survey_design(egodat$egos, ids=ego, weights = weight)
##### make ego data objects #########
## mar/coh
datMarcoh <- egodata(egos=egodat$egos, alters=egodat$altersMarCoh, egoWt = egodat$egos$weight, egoIDcol = "ego")
## others
datOther <- egodata(egos=egodat$egos, alters=egodat$altersOther, egoWt = egodat$egos$weight, egoIDcol = "ego")
## one times
#datOTs <- egodata(egos=egodat$egos, alters=egodat$altersOnce, egoWt = egodat$egos$weight, egoIDcol = "ego")
# want the long data for absdiff age, sex
# this data exclusively contains relationships - no inactive egos
long <- readRDS("~/nsfg_data_cleaning/Objects/altersegos_survdat.rds")
longsvy <- as_survey_design(long, ids=ego, weights = weight)
degs <- egosvy %>%
mutate(sex=as.factor(sex), deg.marcoh=as.factor(deg.marcoh), deg.other=as.factor(deg.other)) %>%
group_by(sex, deg.marcoh, deg.other, .drop = FALSE) %>%
summarize(n = survey_total()) %>%
group_by(sex) %>%
mutate(prop = n/sum(n))
fdeg <- degs %>%
filter(sex=="F") %>%
select(-n, -n_se) %>%
pivot_wider(names_from = deg.other, values_from=prop)
fdeg <- fdeg[,-1]
mdeg <- degs %>%
filter(sex=="M") %>%
select(-n, -n_se) %>%
pivot_wider(names_from = deg.other, values_from=prop)
mdeg <- mdeg[,-1]
kable(fdeg, col.names = c("Degree Marcoh", "Deg Other=0", "Deg Other=1", "Deg Other=2", "Deg Other=3"),
caption="Females") %>% kable_styling(full_width = F)
| Degree Marcoh | Deg Other=0 | Deg Other=1 | Deg Other=2 | Deg Other=3 |
|---|---|---|---|---|
| 0 | 0.4055612 | 0.1447793 | 0.0029561 | 0.0006287 |
| 1 | 0.4445246 | 0.0015368 | 0.0000134 | 0.0000000 |
kable(mdeg, col.names = c("Degree Marcoh", "Deg Other=0", "Deg Other=1", "Deg Other=2", "Deg Other=3"),
caption="Males") %>% kable_styling(full_width = F)
| Degree Marcoh | Deg Other=0 | Deg Other=1 | Deg Other=2 | Deg Other=3 |
|---|---|---|---|---|
| 0 | 0.3848753 | 0.1409088 | 0.0079454 | 0.0014774 |
| 1 | 0.4615956 | 0.0030967 | 0.0001008 | 0.0000000 |
Takeaways:
- Fs in fewer marriage/cohabs than men likely due to age boundary 45
- important heterogeneity by race (lower among black and others), age
- hispanic/white look similar
marcoh <- egosvy %>%
mutate(sex=as.factor(sex), deg.marcoh=as.factor(deg.marcoh), age=as.factor(age)) %>%
group_by(sex, age, deg.marcoh, .drop = FALSE) %>%
summarize(n = survey_total()) %>%
group_by(sex, age) %>%
mutate(prop = n/sum(n)) %>%
filter(deg.marcoh==1) %>%
select(-n, -n_se) %>%
ggplot(aes(x=age, y=prop, fill=sex)) +
geom_col(position="dodge") +
ggtitle("Mean Degree of Marriage/Cohab by Sex & Age")
ggplotly(marcoh)
degreedist(datMarcoh)
degreedist(datMarcoh, by="sex")
degreedist(datMarcoh, by="race")
degreedist(datMarcoh, by="agecat")
degreedist(datMarcoh, by="age")
Takeaways: - important heterogeneity by race (higher in black, lower in others), age
- hispanic/white looks similar
- very small sex differences - age boundary not as much an issue here
casual <- egosvy %>%
mutate(sex=as.factor(sex), deg.other=as.factor(deg.other), age=as.factor(age)) %>%
group_by(sex, age, deg.other, .drop = FALSE) %>%
summarize(n = survey_total()) %>%
group_by(sex, age) %>%
mutate(prop = n/sum(n)) %>%
filter(deg.other != 0) %>%
select(-n, -n_se) %>%
ggplot(aes(x=age, y=prop, fill=sex)) +
geom_col(position="dodge") +
facet_wrap(~deg.other)
ggtitle("Mean Degree of Casual by Sex & Age")
## $title
## [1] "Mean Degree of Casual by Sex & Age"
##
## attr(,"class")
## [1] "labels"
ggplotly(casual)
## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.
# two types
# 1: between-network (marriage/cohab & casual)
# 2: intra-netwokr (casual & casual)
egosvy %>%
mutate(sex=as.factor(sex), deg.other=as.factor(deg.other>=1), deg.marcoh = as.factor(deg.marcoh), age=as.factor(age)) %>%
group_by(sex, age, deg.marcoh, deg.other, .drop = FALSE) %>%
summarize(n = survey_total()) %>%
group_by(sex, age) %>%
mutate(prop = n/sum(n)) %>%
filter(deg.other == TRUE & deg.marcoh != 0) %>%
select(-n, -n_se) %>%
ggplot(aes(x=age, y=prop, fill=sex)) +
geom_col(position="dodge") +
ggtitle("proportion of egos w/ between-network concurrency by sex & age")
## Warning: Removed 1 rows containing missing values (geom_col).
bet <- egosvy %>%
mutate(sex=as.factor(sex), deg.other=as.factor(deg.other>=1), deg.marcoh = as.factor(deg.marcoh), age=as.factor(age)) %>%
group_by(sex, age, deg.marcoh, deg.other, .drop = FALSE) %>%
summarize(n = survey_total()) %>%
group_by(sex, age) %>%
mutate(prop = n/sum(n)) %>%
filter(deg.other == TRUE & deg.marcoh != 0) %>%
select(-n, -n_se) %>%
group_by(sex) %>%
mutate(mean=mean(prop, na.rm = T))
means <- data.frame(Sex = c("Females", "Males"), Mean = unique(bet$mean))
kable(means, caption = "Mean proportion of egos w/ cross-network concurrency by sex") %>%
kable_styling(full_width = F)
| Sex | Mean |
|---|---|
| Females | 0.0015149 |
| Males | 0.0033353 |
egosvy %>%
mutate(sex=as.factor(sex), deg.other=as.factor(deg.other>=2), age=as.factor(age)) %>%
group_by(sex, age, deg.other, .drop = FALSE) %>%
summarize(n = survey_total()) %>%
group_by(sex, age) %>%
mutate(prop = n/sum(n)) %>%
filter(deg.other == TRUE) %>%
select(-n, -n_se) %>%
ggplot(aes(x=age, y=prop, fill=sex)) +
geom_col(position="dodge") +
ggtitle("proportion of egos w/ within-casual-network concurrency by sex & age")
int <- egosvy %>%
mutate(sex=as.factor(sex), deg.other=as.factor(deg.other>1), age=as.factor(age)) %>%
group_by(sex, age, deg.other, .drop = FALSE) %>%
summarize(n = survey_total()) %>%
group_by(sex, age) %>%
mutate(prop = n/sum(n)) %>%
filter(deg.other == TRUE) %>%
select(-n, -n_se) %>%
group_by(sex) %>%
mutate(mean=mean(prop, na.rm = T))
means <- data.frame(Sex = c("Females", "Males"), Mean = unique(int$mean))
kable(means, caption = "Mean proportion of egos w/ casual-network concurrency by sex") %>%
kable_styling(full_width = F)
| Sex | Mean |
|---|---|
| Females | 0.0036151 |
| Males | 0.0094191 |
this needs some work
agemixF <- round(mixingmatrix(datOTs[datOTs$egos$sex %in% "F"], "agecat", rowprob = T), 3)
agemixF <- agemixF[1:6,]
amF <- melt(agemixF)
amF$sex <- "F"
agemixM <- round(mixingmatrix(datOTs[datOTs$egos$sex %in% "M"], "agecat", rowprob = T), 3)
agemixM <- agemixM[1:6,]
amM <- melt(agemixM)
amM$sex <- "M"
am <- rbind(amF, amM)
am %>% ggplot(aes(ego, alter)) +
geom_point(color="blue", alpha=0.2, aes(size=value)) +
scale_size_area(max_size = 30) +
geom_text(aes(label=round(value,2), size=0.015)) +
theme(legend.position="none",
axis.text.x = element_text(angle=45)) +
coord_flip() +
labs(title = "Age Mixing - One-Times") +
facet_wrap(~sex, ncol = 2)
one-times based on Male egos reports of partner race if one-time partner was most recent female one-times partner race based on male reports